home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #193 (1992)(Rhein-Sieg-Soft).adf
/
GFA.Beispiel
/
LOADILBM_V1.0.LST
< prev
next >
Wrap
File List
|
1992-09-14
|
11KB
|
303 lines
' *********************************
' * LoadILBM V.1.00 *
' * (c) 11.6.1991 by Henry König *
' * Bornheide 71, 2000 Hamburg 53 *
' *********************************
'
init
ON MENU GOSUB menuekontrolle
REPEAT
SLEEP
UNTIL ende!
CLOSES 1
CLOSEW #1
END
PROCEDURE fileauswahl(titel$,oktext$,VAR pfad$,name$)
LOCAL pos%
FILESELECT titel$,oktext$,pfad$,name$
pos%=RINSTR(name$,"/")
IF pos%=0 THEN
pos%=RINSTR(name$,":")
ENDIF
IF pos%<>0
pfad$=MID$(name$,1,pos%)
bildname$=MID$(name$,pos%+1)
CLR abbruch%
ELSE
abbruch%=1
ENDIF
RETURN
PROCEDURE initvars
DIM m$(31)
breite%=320 ! Screenbreite
hoehe%=256 ! Screenhöhe
ebenen%=5 ! Anzahl der Bitplanes
farb%=32 ! Anzahl der Farben zum zeichnen
DIM farben%(31,2) ! Farbwerte zum Speichern des IFF-Bildes
DIM ebnadr%(10) ! wie vor
pfad$=DIR$(0) ! System-Pfad
ende!=FALSE
RETURN
PROCEDURE init !
initvars ! Variable initialisieren
OPENS 1,0,0,breite%,hoehe%,ebenen%,&H0
OPENW #1,0,0,breite%,hoehe%,&H18,&H1800,1
scradr%=SCREEN(1)
planesize%=DPEEK(scradr%+184)*DPEEK(scradr%+186)
menueein
MENU m$() ! Menü setzen
RETURN
PROCEDURE lese.chunkname ! Chunknamen und Chunklänge einlesen
form$=""
FOR i%=1 TO 8
form$=form$+CHR$(INP(k%))
NEXT i%
RETURN
PROCEDURE lese.grafik(k%) ! Grafik einlesen und anzeigen
form$=""
SEEK #k%,filepointer%
WHILE LEFT$(form$,4)<>"BODY"
lese.chunkname ! Chunknamen und Chunklänge lesen
IF LEFT$(form$,4)<>"BODY" THEN
lg1%=@chlaenge(form$)
SEEK #k%,LOC(#k%)+lg1%
ENDIF
WEND
mem%=MALLOC(2,0) ! 2 Bytes Speicher reservieren
modus%=0 ! Modus auf Standard setzen
hoehe%=256 ! mindestens 256 Zeilen für die Malroutine
IF breite%>320 THEN ! Bildbreite größer 320 Spalten?
modus%=32768 ! Hires-Modus
ENDIF
IF i_hoehe%>256 THEN ! Bildhöhe größer als 256 Zeilen?
ADD modus%,4 ! ja, dann Interlace-Modus
hoehe%=i_hoehe% ! für die Malroutine
ENDIF
IF ebenen%>5 THEN ! mehr als 5 Bitplanes?
ADD modus%,2048 ! ja. dann HAM-Modus
ENDIF
CLOSEW #1 ! Fenster schließen
CLOSES 1 ! Bildschirm schließen
OPENS 1,0,0,breite%,hoehe%,ebenen%,modus%
OPENW #1,0,0,breite%,hoehe%,&H18,4096+2048
wadr%=WINDOW(1) ! aktuelle Fensteradresse
rp%=LPEEK(wadr%+50) ! Rastportadresse
bm%=LPEEK(rp%+4) ! Adresse der Bitmap-Struktur
FOR i%=0 TO ebenen%-1
ebnadr%(i%)=LPEEK(bm%+8+4*i%) ! Adressen der Bitplanes
NEXT i%
FOR i%=0 TO farb%-1 ! Anzahl der Farben
SETCOLOR i%,farben%(i%,0),farben%(i%,1),farben%(i%,2)
NEXT i%
IF comp%=0 THEN ! Bild nicht gepackt
FOR j1%=0 TO i_hoehe%-1 ! Anzahl der Bildzeilen in Pixel
FOR j2%=0 TO ebenen%-1 ! Anzahl der Bitplanes
scrz=ebnadr%(j2%)+(j1%*i_breite%/8)
BGET #k%,scrz,i_breite%/8
NEXT j2%
NEXT j1%
ELSE IF comp%=1 ! Bild ist gepackt
FOR j1%=0 TO i_hoehe%-1 ! Anzahl der Bildzeilen
FOR j2%=0 TO ebenen%-1 ! Anzahl der Bitplanes
scrz=ebnadr%(j2%)+INT(j1%*breite%/8)
CLR bytez
WHILE bytez<INT(i_breite%/8)
BGET #k%,mem%,1 ! ein Byte lesen
byte=PEEK(mem%)
IF byte<128 THEN
BGET #k%,scrz+bytez,byte+1
bytez=bytez+byte+1
ELSE IF byte>128
BGET #k%,mem%,1
dtbyte=PEEK(mem%)
FOR i=bytez TO bytez+257-byte
POKE scrz+i,dtbyte
NEXT i
bytez=bytez+257-byte
ENDIF
WEND
NEXT j2%
NEXT j1%
ENDIF
dummy%=MFREE(mem%,2) ! reservierten Speicher wieder freigeben
RETURN
PROCEDURE lese.bmhd(k%) ! Bitmap-Header lesen
form$=""
SEEK #k%,filepointer% ! Zeiger auf Anfang der Datei setzen
fp=filepointer% ! Zeiger merken
WHILE LEFT$(form$,4)<>"BMHD"
lese.chunkname ! Chunknamen und Chunklänge lesen
IF LEFT$(form$,4)<>"BMHD" THEN
lg1%=@chlaenge(form$) ! Chunklänge berechnen
SEEK #k%,LOC(#k%)+lg1% ! Zeiger auf den nächsten Chunk setzen
ENDIF
WEND
lg1%=@chlaenge(form$) ! Chunklänge berechnen
mem%=MALLOC(lg1%,0) ! Speicher reservieren
BGET #k%,mem%,lg1% ! Chunk aus der Datei lesen
i_breite%=DPEEK(mem%) ! Gesamtbreite der Grafik
i_hoehe%=DPEEK(mem%+2) ! Gesamthöhe der Grafik
i_xstart%=DPEEK(mem%+4) ! Startposition der Grafik (Rechtswert)
i_ystart%=DPEEK(mem%+6) ! Startposition der Grafik (Hochwert)
ebenen%=PEEK(mem%+8) ! Anzahl der Bitplanes
mask%=PEEK(mem%+9) ! Masking
comp%=PEEK(mem%+10) ! Kompressionart
dummy%=PEEK(mem%+11) ! Füllbyte, frei für Erweiterungen
tcolor%=DPEEK(mem%+12) ! transparente Farbe beim Masking
i_xaspect=PEEK(mem%+14)
i_yaspect=PEEK(mem%+15)
breite%=DPEEK(mem%+16) ! Bildschirmbreite
hoehe%=DPEEK(mem%+18) ! Bildschirmhöhe
dummy%=MFREE(mem%,lg1%) ! reservierten Speicher wieder freigeben
RETURN
PROCEDURE lese.cmap(k%) ! Color Chunk lesen
form$=""
SEEK #k%,filepointer% ! Zeiger auf den Anfang der Datei setzen
WHILE LEFT$(form$,4)<>"CMAP"
lese.chunkname ! Chunknamen und Chunklänge lesen
IF LEFT$(form$,4)<>"CMAP" THEN
lg1%=@chlaenge(form$) ! Chunklänge berechnen
SEEK #k%,LOC(#k%)+lg1% ! Zeiger auf den Chunk in der Datei setzen
ENDIF
WEND
lg1%=@chlaenge(form$) ! Chunklänge berechnen
mem%=MALLOC(lg1%,0) ! Speicher reservieren
BGET #k%,mem%,lg1%
farb%=lg1%/3 ! Anzahl der Farben
FOR i=0 TO farb%-1 ! Farben zur weiteren Auswertung speichern
farben%(i,0)=PEEK(mem%+3*i)/16 ! rot
farben%(i,1)=PEEK(mem%+3*i+1)/16 ! grün
farben%(i,2)=PEEK(mem%+3*i+2)/16 ! blau
NEXT i
dummy%=MFREE(mem%,lg1%) ! reservierten Speicher wieder freigeben
RETURN
PROCEDURE lese.camg(k%) ! View-Mode bestimmen
form$=""
CLR lg1%
CLR ba%
SEEK #k%,filepointer%
WHILE LEFT$(form$,4)<>"CAMG" AND lg1%+LOC(#k%)<lo%
lese.chunkname ! Chunknamen und Chunklänge lesen
IF LEFT$(form$,4)<>"CAMG" THEN
lg1%=@chlaenge(form$)
IF lg1%+LOC(#k%)<lo% THEN ! Zeiger noch < Dateigröße?
SEEK #k%,LOC(#k%)+lg1%
ENDIF
ENDIF
WEND
IF LEFT$(form$,4)<>"BODY" THEN
i_camg=-1
lg1%=@chlaenge(form$) ! Chunklänge berechnen
mem%=MALLOC(lg1%,0) ! Speicher reservieren
BGET #k%,mem%,lg1% ! Modus aus der Datei lesen
ba%=LPEEK(mem%) ! Modus
IF BTST(ba%,7) THEN ! Bit 7 gesetzt?
ba$="EHB" ! ja, dann ist es Extra Half B.-Modus
ELSE IF BTST(ba%,11) ! Bit 11 gesetzt?
ba$="HAM" ! ja, dann ist es der HAM-Modus
ENDIF
dummy%=MFREE(mem%,lg1%) ! reservierten Speicher wieder freigeben
ELSE IF LEFT$(form$,4)<>"BODY" AND lg1%+LOC(#k%)<lo%
lg1%=@chlaenge(form$) ! Chunklänge berechnen
mem%=MALLOC(lg1%,0) ! Speicher reservieren
BGET #k%,mem%,lg1% ! Chunk aus der Datei lesen
i_camg=LPEEK(mem%)
dummy%=MFREE(mem%,lg1%) ! reservierten Speicher wieder freigeben
ENDIF
RETURN
PROCEDURE menueein ! Menüs einschalten
m$(0)="Bild"
m$(1)=" Laden "
m$(2)=" Ende "
m$(3)=""
m$(4)=""
RETURN
PROCEDURE menuekontrolle
SELECT MENU(0)
CASE 1 !Laden
start
menueein
MENU m$()
CASE 2 !Speichern
programmende
ENDSELECT
RETURN
PROCEDURE programmende ! Programm beenden
ALERT 0,"Wollen Sie aufhoeren?",2,"Ende|Weiter",wahl%
ende!=(wahl%=1)
RETURN
PROCEDURE start ! Haupt-Routine
fileauswahl("Laden eines Bildes:","Laden",pfad$,dateiname$)
IF abbruch%=0 THEN ! Abbruchflag nicht gesetzt?
OPEN "i",#1,dateiname$ ! ja, dann Datei öffnen
lo%=LOF(#1) ! Dateigröße
test=@testilbm(1) ! auf IFF-Datei testen
IF test=-1 THEN
PRINT "Keine IFF-Datei"
taste
ELSE IF test=-2
PRINT "Dieses ist eine IFF-Datei, jedoch keine Grafikdatei."
taste
ELSE
lese.bmhd(1) ! Bitmapheader lesen
lese.cmap(1) ! Colormap lesen
lese.camg(1) ! View-Mode lesen
PRINT AT(1,26);" Bildname: ";bildname$
PRINT " Größe: ";i_breite%;" x";i_hoehe%
PRINT "Bitplanes: ";ebenen%
PRINT " Farben: ";
IF ebenen%<6 THEN
PRINT farb%
ELSE
PRINT farb%;" ";
PRINT ba$;"-Modus."
ENDIF
PRINT " Weiter mit Mausklick."
taste
lese.grafik(1)
ENDIF
ENDIF
CLOSE #1 ! Bilddatei schließen
RETURN
PROCEDURE taste ! ein Zeichen von der Tastatur holen
CLR x% ! Steuerzeichen löschen
CLR mausk%
CLR mausx% ! Mausspalte löschen
CLR mausy% ! Mauszeile löschen
WHILE x%=0 AND MOUSEK=0
x$=INKEY$ ! Zeichen von Tastatur
x%=ASC(x$) ! ASCII-Wert für Auswertung
WEND
IF MOUSEK<>0 THEN ! linke Maustaste
mausx%=INT(MOUSEX/8)+1 ! ja, dann Spalte = mausx
mausy%=INT(MOUSEY/8)+1 ! Zeile = mausy
mausk%=MOUSEK ! Maustaste
ENDIF
RETURN
FUNCTION chlaenge(x$) ! Chunklänge berechnen
LOCAL i%,a,b%
CLR a
CLR b%
FOR i%=4 TO 1 STEP -1
a=ASC(MID$(x$,9-i%,1))
b%=b%+a*2^(8*(i%-1))
NEXT i%
RETURN b% ! Chunklänge zurückgeben
ENDFUNC
FUNCTION testilbm(k%) ! auf IFF-Datei testen
form$=""
IF LOF(#k%)<12 THEN ! 12 Bytes lesen
RETURN -1 ! Flag keine IFF-Datei
ENDIF
FOR i=0 TO 11
form$=form$+CHR$(INP(k%))
NEXT i
IF LEFT$(form$,4)<>"FORM" THEN ! die ersten vier Zeichen = "FORM"?
RETURN -1 ! nein, dann keine IFF-Datei
ELSE IF RIGHT$(form$,4)<>"ILBM"
RETURN -2 ! Flag für keine Grafik-Datei
ENDIF
filepointer%=LOC(#k%)
RETURN 0 ! OK-Flag
ENDFUNC